Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/edgetext/clsconfi.cl_/clsconfi.cl

Visual Basic class definition | 1998-06-28 | 30.5 KB | 780 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
END
Attribute VB_Name = "clsConfiguration"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'********************************************************************************************************
'Title:     clsConfiguration
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This class allows easy access to the registry for program configuration
'           I also contains several very useful public methods for string manipulation,
'           INI file access, and miscellaneous.
'********************************************************************************************************

'----------------------------------------
'This class requires the Configuration Form
'which is also generated from the designer
'----------------------------------------
'Here are some registry Constants
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
'List Box and Combo Box constants
Private Const LB_FINDSTRING = &H18F
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const CB_FINDSTRING = &H14C
Private Const CB_FINDSTRINGEXACT = &H158

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

Private Const ERROR_NONE = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0

'--------------------------------------------------------------------------------------------------------------------------
'The following are declarations to read the registry directly
Private Declare Function RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
        "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
        As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
        As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
        "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
        Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
        "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
        As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
        "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal lpReserved As Long, lpType As Long, lpData As _
        Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
        "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
        String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
        As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
        "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
        ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
        String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
        "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
        ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
        ByVal cbData As Long) As Long
Private Declare Function apiWritePrivateProfileString Lib "kernel32" _
        Alias "WritePrivateProfileStringA" (ByVal lpApplicationName _
        As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
        ByVal lpFileName As String) As Long
Private Declare Function apiGetPrivateProfileString Lib "kernel32" _
       Alias "GetPrivateProfileStringA" (ByVal lpApplicationName _
       As String, ByVal lpKeyName As Any, ByVal lpDefault As _
       String, ByVal lpReturnedString As String, ByVal nSize As _
       Long, ByVal lpFileName As String) As Long

Private Declare Function GetUserName Lib "advapi32.dll" _
       Alias "GetUserNameA" (ByVal lpBuffer _
       As String, nSize As Long) As Long
Private Declare Function SendMessage Lib "user32" _
       Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
       ByVal wParam As Long, lParam As Any) As Long

Private Type ConfigType
    Name As String
    Type As String
    Data As String
End Type

Public DataSource As String
Public Connect As String
Public LanId As String
Public ModuleName As String
Public LogonName As String
Public Password As String
Public DisplayErrors As String
Public LogErrors As String
Public LogFile As String
Public DebugFlag As Integer
Private gConfigItems As Long
Private gConfigArray() As ConfigType
Private gConfigItem As Long

Public Static Property Get NameValue() As String
    NameValue = gConfigArray(gConfigItem).Name
End Property

Public Static Property Let NameValue(pNameValue As String)
    gConfigArray(gConfigItem).Name = pNameValue
End Property

Public Static Property Get TypeValue() As String
    TypeValue = gConfigArray(gConfigItem).Type
End Property

Public Static Property Let TypeValue(pTypeValue As String)
    gConfigArray(gConfigItem).Type = pTypeValue
End Property

Public Static Property Get DataValue() As String
    DataValue = gConfigArray(gConfigItem).Data
End Property

Public Static Property Let DataValue(pDataValue As String)
    gConfigArray(gConfigItem).Data = pDataValue
End Property

Public Static Property Get ConfigItem() As Long
    ConfigItem = gConfigItem
End Property

Public Static Property Let ConfigItem(pConfigItem As Long)
    gConfigItem = pConfigItem
End Property

Public Static Property Get ConfigItems() As Long
    ConfigItems = gConfigItems
End Property

Public Static Property Let ConfigItems(pConfigItems As Long)
    gConfigItems = pConfigItems
End Property

Public Sub FillList(List As Control)

Dim I As Integer

    For I = 0 To gConfigItems - 1
        List.AddItem gConfigArray(I).Name
    Next I

End Sub

'********************************************************************************************************
'Title:     Save
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Saves the Data in the Array to the Registry
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
'
Public Sub Save()

Dim I As Long

    FillArray

    For I = 0 To gConfigItems - 1
        If Trim(UCase(gConfigArray(I).Name)) = "PASSWORD" Then
            If RegistryWriteData("Timesheet", Trim(gConfigArray(I).Name), Encrypt(Trim(gConfigArray(I).Data))) = False Then
                Screen.MousePointer = vbNormal
                MsgBox "Error Writing file"
            End If
        Else
            If RegistryWriteData("Timesheet", Trim(gConfigArray(I).Name), Trim(gConfigArray(I).Data)) = False Then
                Screen.MousePointer = vbNormal
                MsgBox "Error Writing file"
            End If
        End If
    Next I

End Sub

'********************************************************************************************************
'Title:     Refresh
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Refreshes the Array with Data from the Registry then calls Fill Class to
'           Fill the Class with the Data also
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
'
Public Sub Refresh()

    gConfigItems = 9
    ReDim gConfigArray(8)
    gConfigArray(0).Name = "DataSource"
    gConfigArray(0).Type = "String"
    If Trim(RegistryReadData("Timesheet", "DataSource")) = "" Then
        gConfigArray(0).Data = "c:\Program Files\TimeSheet\TimeSheet.mdb"
    Else
        gConfigArray(0).Data = RegistryReadData("Timesheet", "DataSource")
    End If
    gConfigArray(1).Name = "Connect"
    gConfigArray(1).Type = "String"
    If Trim(RegistryReadData("Timesheet", "Connect")) = "" Then
        gConfigArray(1).Data = "Access"
    Else
        gConfigArray(1).Data = RegistryReadData("Timesheet", "Connect")
    End If
    gConfigArray(2).Name = "LanId"
    gConfigArray(2).Type = "String"
    If Trim(RegistryReadData("Timesheet", "LanId")) = "" Then
        gConfigArray(2).Data = "N/A"
    Else
        gConfigArray(2).Data = RegistryReadData("Timesheet", "LanId")
    End If
    gConfigArray(3).Name = "ModuleName"
    gConfigArray(3).Type = "String"
    If Trim(RegistryReadData("Timesheet", "ModuleName")) = "" Then
        gConfigArray(3).Data = "TimeSheet"
    Else
        gConfigArray(3).Data = RegistryReadData("Timesheet", "ModuleName")
    End If
    gConfigArray(4).Name = "LogonName"
    gConfigArray(4).Type = "String"
    gConfigArray(4).Data = RegistryReadData("Timesheet", "LogonName")
    gConfigArray(5).Name = "Password"
    gConfigArray(5).Type = "String"
    gConfigArray(5).Data = Decrypt(RegistryReadData("Timesheet", "Password"))
    gConfigArray(6).Name = "DisplayErrors"
    gConfigArray(6).Type = "Boolean"
    If Trim(RegistryReadData("Timesheet", "DisplayErrors")) = "" Then
        gConfigArray(6).Data = "True"
    Else
        gConfigArray(6).Data = RegistryReadData("Timesheet", "DisplayErrors")
    End If
    gConfigArray(7).Name = "LogErrors"
    gConfigArray(7).Type = "Boolean"
    If Trim(RegistryReadData("Timesheet", "LogErrors")) = "" Then
        gConfigArray(7).Data = "True"
    Else
        gConfigArray(7).Data = RegistryReadData("Timesheet", "LogErrors")
    End If
    gConfigArray(8).Name = "LogFile"
    gConfigArray(8).Type = "String"
    If Trim(RegistryReadData("Timesheet", "LogFile")) = "" Then
        gConfigArray(8).Data = "c:\Program Files\Timesheet\TimeSheet.Log"
    Else
        gConfigArray(8).Data = RegistryReadData("Timesheet", "LogFile")
    End If

FillClass

End Sub

'********************************************************************************************************
'Title:     FillArray
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Transfers data from the Class Variables to the Array
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
'
Public Sub FillArray()

    gConfigArray(0).Data = DataSource
    gConfigArray(1).Data = Connect
    gConfigArray(2).Data = LanId
    gConfigArray(3).Data = ModuleName
    gConfigArray(4).Data = LogonName
    gConfigArray(5).Data = Password
    gConfigArray(6).Data = DisplayErrors
    gConfigArray(7).Data = LogErrors
    gConfigArray(8).Data = LogFile

End Sub

'********************************************************************************************************
'Title:     FillClass
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Transfers data from the Array to the Class Variables
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
'
Public Sub FillClass()

    DataSource = gConfigArray(0).Data
    Connect = gConfigArray(1).Data
    LanId = gConfigArray(2).Data
    ModuleName = gConfigArray(3).Data
    LogonName = gConfigArray(4).Data
    Password = gConfigArray(5).Data
    DisplayErrors = gConfigArray(6).Data
    LogErrors = gConfigArray(7).Data
    LogFile = gConfigArray(8).Data

End Sub

'********************************************************************************************************
'Title:     Decrypt
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Decrypts the Password string stored in the INI file for AutoLogin
'Parameters:Password string to decrypt
'Return:    Decrypted Password string
'********************************************************************************************************
'
Public Function Decrypt(Password As String) As String

Dim Count As Integer, Buf2 As String, Buf1 As String

    Buf1 = ZTrim(Password)
    For Count = 1 To Len(Buf1)
        Buf2 = Buf2 & Chr(Asc(Mid(Buf1, Count, 1)) - 10 - Count)
    Next Count
    Decrypt = Buf2

End Function

'********************************************************************************************************
'Title:     Encrypt
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Encrypts the Password string stored in the INI file for AutoLogin
'Parameters:Password string to Encrypt
'Return:    Encrypted Password string
'********************************************************************************************************
'
Public Function Encrypt(Password As String) As String

Dim Count As Integer, Buf2 As String, Buf1 As String

    Buf1 = ZTrim(Password)
    For Count = 1 To Len(Buf1)
        Buf2 = Buf2 & Chr(Asc(Mid(Buf1, Count, 1)) + 10 + Count)
    Next Count
    Encrypt = Buf2

End Function

'********************************************************************************************************
'Title:     RegistryReadData
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Reads Data from the INI File Specified at the Key Location Specified
'Parameters:Progname Heading in the INI file,Key Sub-Heading in the INI file, and Filename of the INI file
'Return:    Retrieved INI Data
'********************************************************************************************************
'
Public Function RegistryReadData(ByVal Progname, ByVal Key As String) As String

Dim ReturnString As String * 257, ReturnValue As Integer
Dim Buf1 As String, TitleBuffer As String

    ReturnString = Space(257)
    ReturnString = GetSetting(Progname, "SETTINGS", Key, "")
    Buf1 = ReturnString
    RegistryReadData = ZTrim(Buf1)

End Function

'********************************************************************************************************
'Title:     RegistryWriteData
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Writes Data to the INI File Specified at the Key Location Specified
'Parameters:Progname Heading in the INI file,Key Sub-Heading in the INI file, Data to be Written, and Filename of the INI file
'Return:    True if Successful, False if unsuccessful
'********************************************************************************************************
'
Public Function RegistryWriteData(ByVal Progname, ByVal Key As String, ByVal KeyData As String) As Integer

Dim ReturnValue As Integer

    SaveSetting Progname, "SETTINGS", Key, KeyData
        RegistryWriteData = True

End Function

'********************************************************************************************************
'Title:     ATrim  (Means All Trim)
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Trims Spaces ,Zeroes, CRs and LFs from the string passed in
'Parameters:String to be Trimmed
'Return:    Trimmed string
'********************************************************************************************************
'
Public Function ATrim(ByVal Buf1 As String) As String

    Do While Left(Buf1, 1) = Chr(0) Or Left(Buf1, 1) = " " Or Left(Buf1, 1) = Chr(13) Or Left(Buf1, 1) = Chr(10)
        Buf1 = Right(Buf1, Len(Buf1) - 1)
    Loop
    Do While Right(Buf1, 1) = Chr(0) Or Right(Buf1, 1) = " " Or Left(Buf1, 1) = Chr(13) Or Left(Buf1, 1) = Chr(10)
        Buf1 = Left(Buf1, Len(Buf1) - 1)
    Loop
    ATrim = Buf1

End Function

'********************************************************************************************************
'Title:     ZTrim (Means Character Zero Trim)
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Trims Spaces and Zeroes from the string passed in. This is important because the INI strings
'           returned are still in the C language traditional format with a trailing zero.
'Parameters:String to be Trimmed
'Return:    Trimmed string
'********************************************************************************************************
'
Public Function ZTrim(ByVal Buf1 As String) As String


    Do While Left(Buf1, 1) = Chr(0) Or Left(Buf1, 1) = Chr(32)
        Buf1 = Right(Buf1, Len(Buf1) - 1)
    Loop
    Do While Right(Buf1, 1) = Chr(0) Or Right(Buf1, 1) = Chr(32)
        Buf1 = Left(Buf1, Len(Buf1) - 1)
    Loop
    ZTrim = Buf1

End Function

'********************************************************************************************************
'Title:     PCase
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Changes strings to proper case
'Parameters:Buffer to be passed
'Return:    buffer to be set to proper case
'********************************************************************************************************

Public Function PCase(ByVal psBuf As String) As String

Dim SpaceFlag As Integer
Dim lsBuf As String
Dim licount As Integer

    If Trim(psBuf) <> "" Then
        For licount = 1 To Len(psBuf)
           If Not SpaceFlag Then
              lsBuf = lsBuf & UCase(Mid(psBuf, licount, 1))
              SpaceFlag = True
           Else
              lsBuf = lsBuf & LCase(Mid(psBuf, licount, 1))
           End If
           If Mid(psBuf, licount, 1) = " " Then
              SpaceFlag = False
           End If
        Next
    End If
    PCase = lsBuf

End Function

'********************************************************************************************************
'Title:     ReplaceChar
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This Function look for the specified char in the supplied buffer, and replace
'           each instance of it in the buffer with the new character supplied
'Parameters:string to be modified, Old character to search for, and the new char to replace with
'Return:    the modified string
'********************************************************************************************************
Public Function ReplaceChar(psBuf As String, OldChar As String, NewChar As String) As String

Dim liStrLen As Integer
Dim liCurChar As Integer
Dim liOldCharPos As Integer
Dim lsOutBuf As String

    liCurChar = 1
    lsOutBuf = ""

    liOldCharPos = InStr(liCurChar, psBuf, OldChar)
    If liOldCharPos = 0 Then
        lsOutBuf = psBuf
    Else
        liStrLen = Len(psBuf)
        Do While liOldCharPos > 0
            lsOutBuf = lsOutBuf & Mid(psBuf, liCurChar, liOldCharPos - liCurChar) & NewChar
            liCurChar = liOldCharPos + 1
            liOldCharPos = InStr(liCurChar, psBuf, OldChar)
        Loop
        lsOutBuf = lsOutBuf & Mid(psBuf, liCurChar, liStrLen)
    End If

    ReplaceChar = lsOutBuf

End Function

'********************************************************************************************************
'Title:     StripNP
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Strips Non Printable Characters from a buffer
'Parameters:Buffer to be passed
'Return:    Stripped buffer
'********************************************************************************************************

Public Function StripNP(psRawBuf As String) As String

Dim licount As Integer
Dim lsCleanBuf As String

    For licount = 1 To Len(psRawBuf)
        If Asc(Mid(psRawBuf, licount, 1)) < 32 Or Asc(Mid(psRawBuf, licount, 1)) > 126 Then
            lsCleanBuf = lsCleanBuf & " "
        Else
            lsCleanBuf = lsCleanBuf & Mid(psRawBuf, licount, 1)
        End If
    Next

    StripNP = lsCleanBuf

End Function

'********************************************************************************************************
'Title:     SetValueEx
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Puts values into the registry at the correct key location according to its type
'Parameters:key where value should be placed, SubKey Name where value is to be placed, type of variable
'           and Value to be Placed in the registry
'Return:    success or fail
'********************************************************************************************************

Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

Dim lValue As Long
Dim sValue As String

    Select Case lType
        Case REG_SZ
            sValue = vValue & Chr(0)
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
                                           lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
            lType, lValue, 4)
    End Select
End Function

'********************************************************************************************************
'Title:     GetKeyValue
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Gets values from the registry at the correct key location
'Parameters:Type of variable,key where value is located, SubKey Name where value is to be placed,
'           and the variable where the retrieved variable will be placed
'Return:    success or fail
'********************************************************************************************************

Public Function GetKeyValue(ByVal lKeyType As Long, ByVal szKeyName As String, ByVal szValueName As String, vValue As Variant) As Long

Dim lhKey As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
Dim RetCode As Long

    On Error GoTo QueryValueExError

    lrc = RegOpenKeyEx(lKeyType, szKeyName, 0, KEY_ALL_ACCESS, lhKey)
    If lrc <> ERROR_NONE Then Error 5

    ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        ' For strings
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left(sValue, cch)
            Else
                vValue = Empty
            End If
        ' For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'all other data types not supported
            lrc = -1
    End Select
    RegCloseKey (lhKey)

QueryValueExExit:
    GetKeyValue = lrc
    Exit Function
QueryValueExError:
    Resume QueryValueExExit
End Function

'********************************************************************************************************
'Title:     SetKeyValue
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   sets a key in the registry
'Parameters:Predefined Key such as HKEY_ROOT,key where value is located, SubKey Name where value is to be placed,
'           and the new value of the key to be placed,and its type
'Return:    success or fail
'********************************************************************************************************

Public Function SetKeyValue(lPredef As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long) As Long

Dim lRetVal As Long         'result of the SetValueEx function
Dim hKey As Long         'handle of open key

    'open the specified key
    lRetVal = RegOpenKeyEx(lPredef, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)

End Function

'********************************************************************************************************
'Title:     CreateNewKey
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   sets a new key into the registry
'Parameters:Predefined Key such as HKEY_ROOT,
'           and the value of the new key to be placed
'Return:    success or fail
'********************************************************************************************************

Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String) As Long

Dim hNewKey As Long         'handle to the new key
Dim lRetVal As Long         'result of the RegCreateKeyEx function

   lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
             vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
             0&, hNewKey, lRetVal)
   RegCloseKey (hNewKey)

End Function

'********************************************************************************************************
'Title:     INIReadData
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Reads data from an INI File
'Parameters:Bracketed INI Value,INI Key Value, and the INI FileName
'Return:    INI String
'********************************************************************************************************

Public Function INIReadData(ByVal Progname, ByVal Key As String, ByVal Filename As String) As String

Dim ReturnString As String, ReturnValue As Long
Dim RetCode As Integer

    ReturnString = Space(257)
    RetCode = apiGetPrivateProfileString(Progname, Key, "", ReturnString, Len(ReturnString), Filename)
    INIReadData = ZTrim(ReturnString)

End Function

'********************************************************************************************************
'Title:     INIWriteData
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Writes data to an INI File
'Parameters:Bracketed INI Value,INI Key Value, Data to be Placed, and the INI FileName
'Return:    Success or fail
'********************************************************************************************************

Public Function INIWriteData(ByVal Progname, ByVal Key As String, ByVal KeyData As String, Filename As String) As Integer

Dim RetCode As Integer

    RetCode = apiWritePrivateProfileString(Progname, Key, KeyData, Filename)
    INIWriteData = True

End Function

'********************************************************************************************************
'Title:     GetLANId
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Gets the LAN Id of the person on the Win 95 or Win NT Computer
'Parameters:none
'Return:    LAN ID
'********************************************************************************************************

Public Function GetLANId() As String

Dim lsBuf As String

    lsBuf = Space(80) + Chr(0)
    If GetUserName(lsBuf, 80) = False Then
        MsgBox "Error Getting User Name", vbExclamation
        GetLANId = ""
        Exit Function
    End If
    If Trim(lsBuf) = "" Then
        MsgBox "You Are Not Logged In to the LAN, Please Shutdown Your computer and Log on as a New User", vbInformation
        GetLANId = ""
        Exit Function
    End If
    GetLANId = UCase(ZTrim(lsBuf))

End Function

'********************************************************************************************************
'Title:     GetCBListIndex
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Finds a String in a Combo box and Returns the list index
'Parameters:Combo Box to Search, and String to Search For
'Return:    ListIndex where string is found, True if not found
'********************************************************************************************************
Public Function GetCBListIndex(pCombo As Control, ByVal psBuf As String) As Long

    GetCBListIndex = SendMessage(pCombo.hwnd, CB_FINDSTRINGEXACT, -1, ByVal psBuf)

End Function

'********************************************************************************************************
'Title:     GetLBListIndex
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Finds a String in a List box and Returns the list index
'Parameters:List Box to Search, and String to Search For
'Return:    ListIndex where string is found, True if not found
'********************************************************************************************************
Public Function GetLBListIndex(pList As Control, ByVal psBuf As String) As Long

    GetLBListIndex = SendMessage(pList.hwnd, LB_FINDSTRINGEXACT, -1, ByVal psBuf)

End Function

'********************************************************************************************************
'Title:     GetKeyListIndex
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   Finds a String or Strings in an Array, then
'           uses the GetCBListIndex function to return the listindex of the
'           item in the box which fits the key
'Parameters:Combo Box to Search, Array to Search, Array with values to find
'Return:    ListIndex where string is found, True if not found
'********************************************************************************************************
Public Function GetKeyListIndex(pCombo As Control, SearchArray() As Variant, FindArray() As Variant) As Long

Dim liSearchCount As Long, liKeyCount As Integer
Dim liMatchCount As Integer, liTotalKeys As Integer

    'Search the Array from 0 to its upper boundary
    liTotalKeys = UBound(SearchArray(), 1)
    For liSearchCount = 1 To UBound(SearchArray(), 2)
        'Reset the Match Counter, and then look at every key for a match
        liMatchCount = 0
        For liKeyCount = 1 To liTotalKeys
            'if a match is found, increment the counter which represents how many keys are a match
            If SearchArray(liKeyCount, liSearchCount) = FindArray(liKeyCount, 1) Then
                liMatchCount = liMatchCount + 1
            End If
        Next
        'if all the keys match, leave the loop
        If liMatchCount = liTotalKeys Then
            Exit For
        End If
    Next

    'if all keys matched, return the search array index that had the match
    If liMatchCount = liTotalKeys Then
        GetKeyListIndex = liSearchCount - 1
    Else
        'otherwise, just return true
        GetKeyListIndex = True
    End If

End Function